www.gusucode.com > 云网互动影视系统(12套模版和资源联盟) 6.2 > 云网互动影视系统(12套模版和资源联盟) 6.2.4/免费版/API/API_Response.asp

    <%@LANGUAGE="VBSCRIPT" CODEPAGE="936"%>
<%
'******************************************************
'文件名： API_Response.asp
'描　述： 云网影视系统PDO远程接口函数文件
'版　本： 云网影视正式版及更高版本适用
'******************************************************
%>
<!-- #Include File = "../Conn.asp" -->
<!-- #Include File = "../Function/Function.asp" -->
<!-- #Include File = "../Function/Md5.asp" -->
<!-- #Include File = "API_Config.asp"-->
<!-- #Include File = "API_Function.asp"-->
<%
Dim recXml
Action = Trim(Request("Action"))
FoundErr = False
ErrMsg = ""
sPE_Items(conSyskey,1) = Trim(Request.QueryString(sPE_Items(conSysKey,0)))
sPE_Items(conUsername,1) = Trim(Request.QueryString(sPE_Items(conUserName,0)))
sPE_Items(conPassword,1) = Trim(Request.QueryString(sPE_Items(conPassword,0)))
sPE_Items(conSavecookie,1) = Trim(Request.QueryString(sPE_Items(conSavecookie,0)))
If sPE_Items(conSyskey,1) <> "" Then
    If sPE_Items(conUsername,1) <> "" Then
        If sPE_Items(conPassword,1) <> "" Then
            WriteCookies
            Response.Write ""
        Else
            CleanCookies
            Response.Write ""
        End If
    End If
Else
    DealResponse
End If

Sub WriteCookies()
    If Not CheckSysKey(sPE_Items(conUsername,1),sPE_Items(conSyskey,1)) Then
        Exit Sub
    End If
    If sPE_Items(conSavecooke,1) <> "" Then
        sPE_Items(conSavecooke,1) = PE_CLng(sPE_Items(conSavecooke,1))
    End If
    Select Case sPE_Items(conSavecooke,1)
    Case 0
        'not save
    Case 1
        Response.Cookies("YWNTUserCookie")("UserName").Expires = Date + 1
		Response.Cookies("YWNTUserCookie")("Password").Expires = Date + 1
    Case 2
        Response.Cookies("YWNTUserCookie")("UserName").Expires = Date + 31
		Response.Cookies("YWNTUserCookie")("Password").Expires = Date + 31
    Case 3
		Response.Cookies("YWNTUserCookie")("Password").Expires = Date + 365
        Response.Cookies("YWNTUserCookie")("UserName").Expires = Date + 365
    End Select
	Response.Cookies("YWNTUserCookie")("UserName") = sPE_Items(conUsername,1)
    Response.Cookies("YWNTUserCookie")("Password") = sPE_Items(conPassword,1)
    Response.Cookies("YWNTUserCookie")("CookieDate") = sPE_Items(conSavecooke,1)
End Sub

Sub CleanCookies()
    If Not CheckSysKey(sPE_Items(conUsername,1),sPE_Items(conSyskey,1)) Then
        Exit Sub
    End If
    Response.Cookies("YWNTUserCookie")("UserName") = ""
    Response.Cookies("YWNTUserCookie")("Password") = ""
    Response.Cookies("YWNTUserCookie")("CookieDate") = ""
End Sub

Sub DealResponse()
    On Error Resume Next
    If createXmlDom Then
        sMyXmlDoc.Load Request
        If sMyXmlDoc.parseError.errorCode <> 0 Then
            FoundErr = True
            ErrMsg = sMyXmlDoc.parseError.reason & "001"
        Else
            sPE_Items(conSyskey,1) = getNodeText(sPE_Items(conSysKey,0))
            sPE_Items(conUsername,1) = getNodeText(sPE_Items(conUserName,0))
            sPE_Items(conAction,1) = getNodeText(sPE_Items(conAction,0))
            
            If sPE_Items(conSysKey,1) = "" Or sPE_Items(conUsername,1) = "" Or sPE_Items(conAction,1) = "" Then
                FoundErr = True
                ErrMsg = "未包含必须元素，数据同步被拒绝!"
            End If
            If Not CheckSysKey(sPE_Items(conUsername,1),sPE_Items(conSyskey,1)) Then
                FoundErr = True
                ErrMsg = "安全码不符，数据同步被拒绝!"
            End If
        End If
    Else
        FoundErr = True
        ErrMsg = "服务器不支持MSXML对象。"
    End If
    If Err Then
        FoundErr = True
        ErrMsg = Err.Description
        Err.Clear
        WriteErrXml
        Exit Sub
    End If
    If FoundErr Then
        sPE_Items(conStatus,1) = "1"
        sPE_Items(conMessage,1) = ErrMsg
        prepareXML False
        WriteXml
        Exit Sub
    End If
    '已处理的元素：syskey,username
    '错误检测完成，开始处理数据
    sPE_Items(conAction,1) = getNodeText(sPE_Items(conAction,0))
    '已处理的元素：syskey,username,action
    Select Case sPE_Items(conAction,1)
        Case "checkname"
            Call checkUser
        Case "reguser"
            Call createUser
        Case "login"
            Call loginUser
        Case "logout"
            Call CleanCookies
        Case "update"
            Call UpdateUser
        Case "delete"
            Call DeleteUser
        Case "getinfo"
            Call GetUserInfo
    End Select
    If FoundErr Then
        sPE_Items(conStatus,1) = "1"
        sPE_Items(conMessage,1) = ErrMsg
        prepareXML(False)
        WriteXml
        Exit Sub
    Else
        sPE_Items(conStatus,1) = "0"
        prepareXML(False)
        WriteXml
    End If        
End Sub

Sub checkUser
    sPE_Items(conEmail,1) = getNodeText(sPE_Items(conEmail,0))
    CheckUserName(sPE_Items(conUsername,1))
    CheckUserEmail(sPE_Items(conEmail,1))
End Sub

Sub createUser
    sPE_Items(conEmail,1) = getNodeText(sPE_Items(conEmail,0))
    If CheckUserName(sPE_Items(conUsername,1)) = False Or CheckUserEmail(sPE_Items(conEmail,1)) = False Then
        Exit Sub
    End If
    prepareData True
    Dim sqlReg, rsReg ,CheckNum
    Set rsReg = Server.CreateObject(YWNT_TMS_RS)
	sqlReg = "select * from YWNT_TMS_Users"
	rsReg.Open sqlReg,conn,1,3    
	rsReg.addnew
	rsReg("UsersName") = sPE_Items(conUsername,1)
	rsReg("UsersPassword") = MD5(sPE_Items(conPassword,1),16)
	rsReg("UsersTrueName") = sPE_Items(conTruename,1)
	rsReg("UsersProblems") = sPE_Items(conQuestion,1)
	rsReg("UsersAnswer") = sPE_Items(conAnswer,1)
	rsReg("UsersEmail") = sPE_Items(conEmail,1)
	rsReg("UsersGroup")=GetUsersSystem("UsersRegGroup")
	rsReg("UsersType")=GetUsersSystem("UsersRegType")
	Select Case GetUsersSystem("UsersRegType")
	Case 0
	rsReg("UsersCoin")=GetUsersSystem("UsersRegCoin")
	Case 1
	rsReg("UsersCoinDate")=Now()+GetUsersSystem("UsersRegDate")
	End Select
	rsReg("UsersRegDate")=date()
    rsReg.Update
    rsReg.Close
    Set rsReg = Nothing
End Sub

Sub loginUser
    Dim oklook
    sPE_Items(conPassword,1) = getNodeText(sPE_Items(conPassword,0))
    sPE_Items(conPassword,1) = Md5(sPE_Items(conPassword,1),16)
    Dim tRs
    Set tRs = Conn.Execute("select UsersName,UsersPassword from YWNT_TMS_Users where UsersName='" & sPE_Items(conUsername,1) & "' and UsersPassword='"&sPE_Items(conPassword,1)&"'")
    If tRs.Bof And tRs.Eof Then
        FoundErr = True
        ErrMsg = ErrMsg & "Pass:" & sPE_Items(conPassword,1) & "--user:" & sPE_Items(conUsername,1)
	Else 
	Call UsersLoginSever(tRS("UsersName"),tRS("UsersPassword"))
    End If
    tRs.Close
    Set tRs = Nothing
End Sub

Sub UpdateUser
    Dim tRs,tUserID
    Set tRs = Conn.Execute("SELECT UsersName FROM YWNT_TMS_Users WHERE UsersName='" & sPE_Items(conUsername,1) & "'")
    If tRs.Eof And tRs.Bof Then
        FoundErr = True
        ErrMsg = "数据库中没有此用户的记录!"
    End If
    tRs.Close
    Set tRs = Nothing
    If FoundErr Then Exit Sub
    
    prepareData True
    
    On Error Resume Next
    Dim tSql
     tSql = "SELECT * FROM YWNT_TMS_Users WHERE UsersName='" & sPE_Items(conUsername,1) & "'"
    Set tRs = Server.CreateObject("adodb.recordset")
    tRs.Open tSql,Conn,1,3
    If sPE_Items(conPassword,1) <> "" Then
        tRs("UsersPassword") = MD5(sPE_Items(conPassword,1),16)
    End If
    If sPE_Items(conQuestion,1) <> "" Then
        tRs("UsersProblems") = sPE_Items(conQuestion,1)
    End If
    If sPE_Items(conAnswer,1) <> "" Then
        tRs("UsersAnswer") = sPE_Items(conAnswer,1)
    End If
    If sPE_Items(conEmail,1) <> "" Then
        tRs("UsersEmail") = sPE_Items(conEmail,1)
    End If
    If sPE_Items(conUserstatus,1) <> "" Then
       	tRs("UsersState") = sPE_Items(conUserstatus,1)
    End If
	 If sPE_Items(conQQ,1) <> "" Then
       	tRs("UsersQQ") = sPE_Items(conQQ,1)
    End If
    tRs.UPDATE
    tRs.Close    
End Sub

Sub DeleteUser
    Dim arrUserNames,iUserIndex
    arrUserNames = Split(sPE_Items(conUsername,1),",")
    For iUserIndex = 0 to Ubound(arrUserNames)
        Dim rsDel
		delName = arrUsernames(iUserIndex)
    Conn.Execute "delete from YWNT_TMS_Users WHERE UsersName='" & delName & "'"
	conn.execute "delete from YWNT_TMS_UsersCollection WHERE CollectionUsers = '"&delName&"'"
	conn.execute "delete from YWNT_TMS_Comments WHERE CommentsUsers = '"&delName&"'"
	conn.execute "delete from YWNT_TMS_UsersLog WHERE UsersName = '"&delName&"'"
	conn.execute "delete from YWNT_TMS_DemandMovie WHERE DemandUsers = '"&delName&"'"
    Next
End Sub

Sub GetUserInfo
    Dim rsInfo,dsUser
    Set rsInfo = Conn.Execute("SELECT * FROM YWNT_TMS_Users WHERE UsersName='" & sPE_Items(conUsername,1) & "'")
    If rsInfo.Eof And rsInfo.Bof Then
        FoundErr = True
        ErrMsg = "查询的用户不存在"
    Else 
        sPE_Items(conPassword,1) = rsInfo("UsersPassword")
        sPE_Items(conEmail,1) = rsInfo("UsersEmail")
        sPE_Items(conQuestion,1) = rsInfo("UsersProblems")
        sPE_Items(conAnswer,1) = rsInfo("UsersAnswer")
        sPE_Items(conJointime,1) = rsInfo("UsersRegDate")
        sPE_Items(conUserIP,1) = rsInfo("UsersIP")
        sPE_Items(conBalance,1) = ""
        sPE_Items(conExperience,1) = ""
        sPE_Items(conValuation,1) = ""
        sPE_Items(conTicket,1) = ""
        sPE_Items(conPosts,1) = ""
        sPE_Items(conUserstatus,1) = rsInfo("UsersState")
		sPE_Items(conTruename,1) = rsInfo("UsersTrueName")
		sPE_Items(conQQ,1) = rsInfo("UsersQQ")
    End If
    rsInfo.Close

    If FoundErr Then
        Set rsInfo = Nothing
        Exit Sub
    End If
End Sub

Function CheckSysKey(iName,iSysKey)
    If IsNull(iName) or iName = "" or IsNull(iSysKey) or iSysKey = "" Then
        CheckSysKey = False
        Exit Function
    End If
    If Len(iSysKey) = 32 Then
        iSysKey = Mid(iSysKey,9,16)
    End If
    Dim strPEKey
    strPEKey = Md5(iName&API_Key,16)
    If Lcase(iSysKey) = Lcase(strPEKey) Then
        CheckSysKey = True
    Else
        CheckSysKey = False
    End If
End Function

Function CheckUserName(iName)
    FoundErr = False
    If InStr(iName, "=") > 0 Or InStr(iName, "%") > 0 Or InStr(iName, Chr(32)) > 0 Or InStr(iName, "?") > 0 Or InStr(iName, "&") > 0 Or InStr(iName, ";") > 0 Or InStr(iName, ",") > 0 Or InStr(iName, "'") > 0 Or InStr(iName, ",") > 0 Or InStr(iName, Chr(34)) > 0 Or InStr(iName, Chr(9)) > 0 Or InStr(iName, "") > 0 Or InStr(iName, "$") > 0 Or InStr(iName, "*") Or InStr(iName, "|") Or InStr(iName, """") > 0 Then
        FoundErr = True
        ErrMsg = ErrMsg & "用户名中含有非法字符"
    End If
    If FoundErr = True Then Exit Function
    Dim rsCheckReg
    Set rsCheckReg = Conn.Execute("select UsersName from YWNT_TMS_Users where UsersName='" & iName & "'")
    If Not (rsCheckReg.Eof And rsCheckReg.Bof) Then
        FoundErr = True
        ErrMsg = ErrMsg & "“" & iName & "”已经存在！请换一个用户名再试试！"
    End If
    rsCheckReg.Close
    Set rsCheckReg = Nothing
    If FoundErr = True Then
        CheckUserName = False
    Else
        CheckUserName = True
    End If
End Function

Function CheckUserEmail(iEmail)
    Dim SqlcheckUser,rsCheckReg,rsCheckUser
    If  iEmail<> "" Then
        strSqlcheckUser = "SELECT UsersEmail FROM YWNT_TMS_Users WHERE UsersEmail='"& iEmail &"'"
        Set rsCheckUser = Conn.Execute(strSqlCheckUser)
        If Not (rsCheckUser.Eof AND rsCheckUser.Bof) Then
            FoundErr = True
            ErrMsg = ErrMsg & "您所填写的Email已经存在！"
            CheckUserEmail = False
        Else
            CheckUserEmail = True
        End If
        rsCheckUser.Close
        Set rsCheckUser = Nothing
    Else
        CheckUserEmail = True
    End If
End Function
%>